Jak zjistit informace o aktualnim uzivateli?
Otázka od: Ing. Igor Vodicka
23. 8. 2004 13:37
Ahoj vsichni!
Potreboval bych zjistit jmeno prihlaseneho uzivatele do windows a jeho
zarazeni do skupiny, zda je administrator, power users nebo users (D5 ent).
Nevite jak na to? Existuje nejaka funkce v JCL?
Predem diky
Ing. Igor Vodicka
informacni systemy
Nakladatelstvi Sagit
Tel.: 59 6786 001
HTTP://www.sagit.cz/
Odpovedá: Josef Straka
23. 8. 2004 13:57
Nalogovany uzivatel by sel zjistit treba takto:
function NalogovanyUzivatel:String;
var User: PChar;
L : Dword;
begin
L := 1024;
User := StrAlloc(Succ(L));
if GetUserName(User, L) then
Result := StrPas(User)
else Result := '?';
end;
Straka Josef
mail: strakajosef@quick.cz
www: http://strakaj.zde.cz
----- Original Message -----
From: "Ing. Igor Vodicka" <vodicka@sagit.cz>
> Potreboval bych zjistit jmeno prihlaseneho uzivatele do windows a
jeho
> zarazeni do skupiny, zda je administrator, power users nebo users
(D5 ent).
> Nevite jak na to? Existuje nejaka funkce v JCL?
Odpovedá: Ing. Miroslav Vopalecky
24. 8. 2004 6:50
Ahoj.
Je mozne pouzit nasledujici funkci, ktera vrati promennou:
function GetEnvVar(const Name:String):String;
var L:Dword;
begin
L:=GetEnvironmentVariable(PChar(Name),nil,0);
SetString(Result,nil,L);
if GetEnvironmentVariable(PChar(Name),PChar(Result),L) <> L-1 then
begin
RaiseLastOSError;
//RaiseLastWin32Error;
end;
end;
a jeji volani:
Uzivatel := GetEnvVar('USERNAME');
CestaTemp:= GetEnvVar('TEMP');
S pozdravem Mirek Vopalecky, D7 W2000
-----Original Message-----
From: delphi-l-owner@clexpert.cz [mailto:delphi-l-owner@clexpert.cz] On
Behalf Of Ing. Igor Vodicka
Sent: Monday, August 23, 2004 2:37 PM
To: delphi-l@clexpert.cz
Subject: Jak zjistit informace o aktualnim uzivateli?
Ahoj vsichni!
Potreboval bych zjistit jmeno prihlaseneho uzivatele do windows a jeho
zarazeni do skupiny, zda je administrator, power users nebo users (D5 ent).
Nevite jak na to? Existuje nejaka funkce v JCL?
Predem diky
Ing. Igor Vodicka
informacni systemy
Nakladatelstvi Sagit
Tel.: 59 6786 001
HTTP://www.sagit.cz/
Odpovedá: Ing. Igor Vodicka
24. 8. 2004 7:38
> -----Original Message-----
> From: delphi-l-owner@clexpert.cz [mailto:delphi-l-owner@clexpert.cz]On
> Behalf Of Josef Straka
> Nalogovany uzivatel by sel zjistit treba takto:
>
> function NalogovanyUzivatel:String;
> var User: PChar;
> L : Dword;
> begin
> L := 1024;
> User := StrAlloc(Succ(L));
> if GetUserName(User, L) then
> Result := StrPas(User)
> else Result := '?';
> end;
>
> -----Original Message-----
> From: delphi-l-owner@clexpert.cz [mailto:delphi-l-owner@clexpert.cz]On
> Behalf Of Ing. Miroslav Vopalecky
> Je mozne pouzit nasledujici funkci, ktera vrati promennou:
>
> function GetEnvVar(const Name:String):String;
> var L:Dword;
> begin
> L:=GetEnvironmentVariable(PChar(Name),nil,0);
> SetString(Result,nil,L);
> if GetEnvironmentVariable(PChar(Name),PChar(Result),L) <> L-1 then
> begin
> RaiseLastOSError;
> //RaiseLastWin32Error;
> end;
> end;
>
> a jeji volani:
> Uzivatel := GetEnvVar('USERNAME');
> CestaTemp:= GetEnvVar('TEMP');
Diky, ano to vsechno funguje (mimochodem seznam vsech variables se da
zjistit funkci GetEnvironmentVars z JCL), ale jeste bych potreboval zjistit
informaci do jake skupiny uzivatelu patri aktualini uzivatel, tj.
administrators, power users, users nebo guest.
Pokousel jsem se vyuzit funkci NetUserGetInfo, ale nejak mi to neslo. Pouzil
nekdo uz tuto funkci, byl bych vdecny za maly prikladek.
Ing. Igor Vodicka
informacni systemy
Nakladatelstvi Sagit
Tel.: 59 6786 001
HTTP://www.sagit.cz/
Odpovedá: Robert Suska
24. 8. 2004 7:52
Ahoj
asi takto
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
PLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1;
LOCALGROUP_MEMBERS_INFO_1 = record
lgrmi1_sid: PSID;
lgrmi1_sidusage: SID_NAME_USE;
lgrmi1_name: LPWSTR;
end;
function NetLocalGroupGetMembers(
servername: PWideChar;
localgroupname: PWideChar;
level: DWORD;
var bufptr: Pointer;
prefmaxlen: DWORD;
var entriesread: DWORD;
var totalentries: DWORD;
var resumehandle: DWORD): Integer; stdcall; external 'netapi32.dll';
function NetApiBufferFree(buffer: Pointer): Integer; stdcall; external
'netapi32.dll';
var
Form1: TForm1;
{$R *.dfm}
implementation
procedure GetLocalGroupUsers(lpwServer, lpwGroup : PWideChar);
type
TUserArray = array of LOCALGROUP_MEMBERS_INFO_1;
var
pBuffer: Pointer;
cbRead,cbTotal,Res,hRes: Cardinal;
i: Integer;
begin
hRes := 0;
repeat
Res := NetLocalGroupGetMembers(lpwServer, lpwGroup, 1, pBuffer, 1024,
cbRead, cbTotal, hRes);
if (Res = 0) or (Res = ERROR_MORE_DATA) then
begin
for i := 0 to cbRead-1 do
Form1.ListBox1.Items.Add(TUserArray(pBuffer)[i].lgrmi1_name);
NetApiBufferFree(pBuffer);
end;
until Res<>ERROR_MORE_DATA;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ListBox1.Items.Add('Skupina - Administrators');
GetLocalGroupUsers('', 'Administrators'); // prazdny retazec je lokalny
stroj
ListBox1.Items.Add('');
ListBox1.Items.Add('');
ListBox1.Items.Add('Skupina - Power Users');
GetLocalGroupUsers('', 'Power Users');
ListBox1.Items.Add('');
ListBox1.Items.Add('');
ListBox1.Items.Add('Skupina - Users');
GetLocalGroupUsers('', 'Users');
end;
end.
S pozdravom,
Robo
> Diky, ano to vsechno funguje (mimochodem seznam vsech variables se da
> zjistit funkci GetEnvironmentVars z JCL), ale jeste bych potreboval
zjistit
> informaci do jake skupiny uzivatelu patri aktualini uzivatel, tj.
> administrators, power users, users nebo guest.
>
> Pokousel jsem se vyuzit funkci NetUserGetInfo, ale nejak mi to neslo.
Pouzil
> nekdo uz tuto funkci, byl bych vdecny za maly prikladek.
>
> Ing. Igor Vodicka
> informacni systemy
> Nakladatelstvi Sagit
> Tel.: 59 6786 001
> HTTP://www.sagit.cz/
Odpovedá: Ing. Igor Vodicka
24. 8. 2004 9:41
> -----Original Message-----
> From: delphi-l-owner@clexpert.cz [mailto:delphi-l-owner@clexpert.cz]On
> Behalf Of Robert Suska
>
> procedure GetLocalGroupUsers(lpwServer, lpwGroup : PWideChar);
> type
> TUserArray = array of LOCALGROUP_MEMBERS_INFO_1;
> var
> pBuffer: Pointer;
> cbRead,cbTotal,Res,hRes: Cardinal;
> i: Integer;
> begin
> hRes := 0;
> repeat
> Res := NetLocalGroupGetMembers(lpwServer, lpwGroup, 1, pBuffer, 1024,
> cbRead, cbTotal, hRes);
> if (Res = 0) or (Res = ERROR_MORE_DATA) then
> begin
> for i := 0 to cbRead-1 do
> Form1.ListBox1.Items.Add(TUserArray(pBuffer)[i].lgrmi1_name);
> NetApiBufferFree(pBuffer);
> end;
> until Res<>ERROR_MORE_DATA;
> end;
Diky za typ. Upravil jsem si tuto proceduru na novou funkci:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
JclSecurity, StdCtrls, JclSysInfo;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
L_username: TLabel;
L_privilege: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
P_USER_INFO_1 = ^_USER_INFO_1;
_USER_INFO_1 = record
usri1_name: LPWSTR;
usri1_password: LPWSTR;
usri1_password_age: DWORD;
usri1_priv: DWORD;
usri1_home_dir: LPWSTR;
usri1_comment: LPWSTR;
usri1_flags: DWORD;
usri1_script_path: LPWSTR;
end;
function NetUserGetInfo(
servername: PWideChar;
localgroupname: PWideChar;
level: DWORD;
var bufptr: Pointer): Integer; stdcall; external 'netapi32.dll';
function NetApiBufferFree(buffer: Pointer): Integer; stdcall; external
'netapi32.dll';
function GetEnvVar(const Name:String):String;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetGroupCurrentUser(lpwServer, lpwUserName : PWideChar): string;
type
TGroupArray = array of _USER_INFO_1;
var
pBuffer: Pointer;
Res: Cardinal;
begin
Res := NetUserGetInfo(lpwServer, lpwUserName, 1, pBuffer);
if (Res = 0) or (Res = ERROR_MORE_DATA) then
begin
case TGroupArray(pBuffer)[0].usri1_priv of
0 : Result := 'USER_PRIV_GUEST';
1 : Result := 'USER_PRIV_USER';
2 : Result := 'USER_PRIV_ADMIN';
else
Result := 'other';
end;
NetApiBufferFree(pBuffer); //Tady mi to konci chybou
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
Var
Buffer: PWideChar;
begin
L_username.Caption := GetEnvVar('USERNAME');
L_privilege.Caption := GetGroupCurrentUser('',
StringToWideChar(L_username.Caption,Buffer,20));
end;
function GetEnvVar(const Name:String):String;
var L:Dword;
begin
L:=GetEnvironmentVariable(PChar(Name),nil,0);
SetString(Result,nil,L);
if GetEnvironmentVariable(PChar(Name),PChar(Result),L) <> L-1 then
begin
// RaiseLastOSError;
RaiseLastWin32Error;
end;
end;
end.
Ale konci mi to chybou. Delam neco spatne? Podivejte se prosim na to nekdo.
Predem moc diky.
Igor Vodicka
Odpovedá: Ing. Igor Vodicka
25. 8. 2004 9:10
> -----Original Message-----
> From: delphi-l-owner@clexpert.cz [mailto:delphi-l-owner@clexpert.cz]On
> Behalf Of Robert Suska
>
> unit Unit1;
>
> interface
>
> uses
> Windows, Messages, SysUtils, Variants, Classes, Graphics,
> Controls, Forms,
> Dialogs, StdCtrls;
>
> type
> TForm1 = class(TForm)
> ListBox1: TListBox;
> Button2: TButton;
> procedure Button2Click(Sender: TObject);
> private
> { Private declarations }
> public
> { Public declarations }
> end;
>
> type
> PLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1;
> LOCALGROUP_MEMBERS_INFO_1 = record
> lgrmi1_sid: PSID;
> lgrmi1_sidusage: SID_NAME_USE;
> lgrmi1_name: LPWSTR;
> end;
>
> function NetLocalGroupGetMembers(
> servername: PWideChar;
> localgroupname: PWideChar;
> level: DWORD;
> var bufptr: Pointer;
> prefmaxlen: DWORD;
> var entriesread: DWORD;
> var totalentries: DWORD;
> var resumehandle: DWORD): Integer; stdcall; external 'netapi32.dll';
>
> function NetApiBufferFree(buffer: Pointer): Integer; stdcall; external
'netapi32.dll';
Pokud funkci NetApiBufferFree pouziji v programu na Win 2000 nebo XP tak vse
funguje OK.
Na Win 9X se ale objevuje hlaseni, ze
"Soubor EXE je propojen na chybejici
export NETAPI32.DLL:NetApiBufferFree",
tzn. ze v dane DLL funkce neni.
Jak to resit, aby se na Win 9X dana dll "nepouzivala", daji se pouzit nejake
direktivy nebo prepinace?
Mohla by se take NETAPI32.DLL kopirovat s programem na cilovy pocitac, ale
nevim jak je to s (c). Navic pokus o premazani NETAPI32.DLL novejsi verzi
byl odmitnut.
Jinymi slovy, potrebuji pri spusteni programu zjistit (na Win 9X test nemusi
probehnout), ze aktualni uzivatel je minimalne "power users". Program totiz
potrebuje prava pro zapis do slozek v progam files, kde ja nainstalovany.
Ing. Igor Vodicka
informacni systemy
Nakladatelstvi Sagit
Tel.: 59 6786 001
HTTP://www.sagit.cz/
Odpovedá: Ondrej Kelle
25. 8. 2004 9:30
> Jak to resit, aby se na Win 9X dana dll "nepouzivala", daji
> se pouzit nejake direktivy nebo prepinace?
Nahrad si to staticke linkovanie dynamickym, t.j. namiesto deklaracii
"external" pouzi LoadLibrary a GetProcAddress.
Priklady najdes aj vo VCL.
HTH
TOndrej